home *** CD-ROM | disk | FTP | other *** search
/ ShareWare OnLine 2 / ShareWare OnLine Volume 2 (CMS Software)(1993).iso / cad / mar93cad.zip / TIP856.LSP < prev   
Text File  |  1993-02-13  |  2KB  |  65 lines
  1. ; TIP856: WALLTEE.LSP (c)1993, Jason E. Baker
  2.  
  3. (defun nearestpt(entlist selectpt / temppt nearpt)
  4.  (setq ang (angle (cdr (assoc 10 entlist))(cdr (assoc 11 entlist))))
  5.  (setq temppt (polar selectpt (+ ang 1.5707963) 1))
  6.  (setq nearpt (inters temppt selectpt (cdr (assoc 10 entlist))(cdr (assoc 11 entlist)) nil))
  7. )
  8.  
  9. (defun c:wtee(/ top tee1 tee2 tee1selpt tee2selpt tee2sp
  10.                tee2sp topsp topep int1 int2 dt1spsel dt2spsel dt1spint dt2spint
  11.                selint1 selint2 topsint topeint flg cla)
  12.  (setvar "cmdecho" 0)
  13.  (setvar "highlight" 0)
  14.  (setq cla (getvar"clayer"))
  15.  (setq topsel (nearestpt (setq top (entget (car (setq tmp (entsel "\nSelect wall to be teed to:  ")))))(cadr tmp))
  16.        tee1sel (nearestpt (setq tee1 (entget (car (setq tmp (entsel "\nSelect first wall line:  ")))))(cadr tmp))
  17.        tee2sel (nearestpt (setq tee2 (entget (car (setq tmp (entsel "\nSelect second wall line:  ")))))(cadr tmp))
  18.        tee1sp (cdr (assoc 10 tee1))
  19.        tee1ep (cdr (assoc 11 tee1))
  20.        tee2sp (cdr (assoc 10 tee2))
  21.        tee2ep (cdr (assoc 11 tee2))
  22.        topsp (cdr (assoc 10 top))
  23.        topep (cdr (assoc 11 top))
  24.        int1 (inters tee1sp tee1ep topep topsp nil)
  25.        int2 (inters tee2sp tee2ep topep topsp nil)
  26.        dt1spsel (distance tee1sp tee1sel)
  27.        dt2spsel (distance tee2sp tee2sel)
  28.        dt1epsel (distance tee1ep tee1sel)
  29.        dt1spint (distance tee1sp int1)
  30.        dt2spint (distance tee2sp int2)
  31.        selint1 (distance tee1sel int1)
  32.        selint2 (distance tee2sel int2)
  33.        topsint (distance topsp int1)
  34.        topeint (distance topsp int2)
  35.  )                                 
  36.  (command "erase" (cdar top)(cdar tee1)(cdar tee2) ""
  37.           "layer" "s" (cdr (assoc 8 top)) "")
  38.  (if (if (< topsint topeint)
  39.          (command "line" topsp int1 "")
  40.          (progn
  41.            (command "line" topsp int2 "")
  42.            (setq flg T)
  43.          )
  44.      );if
  45.      (command "line" topep int1 "")
  46.      (command "line" topep int2 "")
  47.  );if
  48.  
  49.  (if (= (+ dt1spsel selint1) dt1spint)
  50.      (command "line" int1 tee1sp "")
  51.      (command "line" int1 tee1ep "")
  52.  )
  53.  (if (= (+ dt2spsel selint2) dt2spint)
  54.      (command "line" int2 tee2sp "")
  55.      (command "line" int2 tee2ep "")
  56.  )
  57.  (command "layer" "s" cla "")
  58.  (setvar "cmdecho" 1)
  59.  (setvar "highlight" 1)
  60. )
  61.  
  62.  
  63.  
  64. 
  65.